Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue60/Focus/CtlFocus.pas

Pascal/Delphi Source File | 2000-06-15 | 7.7 KB | 280 lines

{+--------------------------------------------------------------------------+
 | Component:   TCtlFocus
 | Created:     2000/06/15
 | Author:      Hart Kerbel
 | Company:     HartWare
 | Copyright    2000, all rights reserved.
 | Description: Control Focus.
 | Version:            1.0
 | Modification History:
 +--------------------------------------------------------------------------+}
unit CtlFocus;

interface

uses
    Messages, Classes, Graphics, Controls, Forms;

const
    DEFAULT_FOCUSED_COLOR = clYellow;

type
    TNotifyColorChangeEvent = procedure (Sender: TObject; const AComponent : TComponent;
                                                                             var ANewColor : TColor;
                                                                             var AChangeColor : Boolean ) of object;

type
    TCtlFocus = class(TComponent)
    private
        FHostForm : TCustomForm;                            // Refrence to form containing control.
        FLastFocusedCtrl : TWinControl;                // Last control to be focused.

        FHostFormWndProc : TWndMethod;                // Host form's WndProc.

        FEnabled: Boolean;

        FFocusedColor: TColor;
        FLastColor : TColor;                  // Remember the original color.

        {- Events Handlers. -}
        FOnAfterFocus: TNotifyColorChangeEvent;
        FOnBeforeFocus: TNotifyColorChangeEvent;

    protected
        procedure FocusChanged;
        procedure AlterCtrlState; virtual;
        procedure RestoreCtrlState; virtual;

        procedure SetEnabled(const Value: Boolean); virtual;
        procedure SetFocusedColor(const Value: TColor); virtual;

        procedure CtlFocusWndProc(var Message: TMessage); virtual;

        procedure DoBeforeFocus(var AChangeColor: Boolean;
                                                        var AFocusedColor: TColor); virtual;
        procedure DoAfterFocus(var AChangeColor: Boolean;
                                                     var AFocusedColor: TColor;
                                                     const AComponent :TComponent ); virtual;

        function SetColorProperty(AComponent: TComponent;
                                                            var ACurrentColor: TColor;
                                                            const AFocusedColor: TColor) : Boolean; virtual;

        function RunTime: Boolean;            // Returns true if it's run-time (vs design time).

    public
        constructor Create(AOwner : TComponent); override;
        destructor Destroy; override;

    published
        property Enabled : Boolean
            read FEnabled
            write SetEnabled
            default True;

        property FocusedColor : TColor
            read  FFocusedColor
            write SetFocusedColor
            default DEFAULT_FOCUSED_COLOR;

        property OnBeforeFocus : TNotifyColorChangeEvent
            read FOnBeforeFocus
            write FOnBeforeFocus;

        property OnAfterFocus : TNotifyColorChangeEvent
            read FOnAfterFocus
            write FOnAfterFocus;
    end; { TCtlFocus }

    procedure Register;

{==============================================================================}

implementation
uses
    TypInfo;

destructor TCtlFocus.Destroy;
begin
    {-
        Restore original WndProc. Technically only required if CtlFocus is dynamically
        created and destroyed, but a good practice to always follow.
    -}
    if RunTime then
        FHostForm.WindowProc := FHostFormWndProc;

    inherited Destroy;
end; { Destroy }

{------------------------------------------------------------------------------}

constructor TCtlFocus.Create(AOwner : TComponent);
begin
    inherited Create(AOwner);

    FHostForm := TCustomForm(AOwner);
    FLastFocusedCtrl := nil;
    FFocusedColor := DEFAULT_FOCUSED_COLOR;
    Enabled := True;

    {- Subclass the host form if it is run time. -}
    if RunTime then
    begin
        FHostFormWndProc := FHostForm.WindowProc;
        FHostForm.WindowProc := CtlFocusWndProc;
    end;
end; { Create }

{------------------------------------------------------------------------------}

procedure TCtlFocus.SetEnabled(const Value: Boolean);
begin
    FEnabled := Value;

    if FEnabled then
        FocusChanged
    else
        RestoreCtrlState;
end; { SetEnabled }

{------------------------------------------------------------------------------}

procedure TCtlFocus.SetFocusedColor(const Value: TColor);
begin
    FFocusedColor := Value;

    if Enabled then
        FocusChanged;
end; { SetFocusedColor }

{------------------------------------------------------------------------------}

procedure TCtlFocus.CtlFocusWndProc(var Message: TMessage);
begin
    case Message.Msg of
        CM_FOCUSCHANGED:      // Focus has shifted within form.
            FocusChanged;

        CM_DEACTIVATE:                // Host form is about to loose focus.
            RestoreCtrlState;

        CM_ACTIVATE:                    // Host form is about to (re)gain focus.
            FocusChanged;
    end; {case}

    {- Pass all messages on to original WndProc. -}
    FHostFormWndProc(Message);
end; { CtlFocusWndProc }

{------------------------------------------------------------------------------}

procedure TCtlFocus.FocusChanged;
begin
    if not Enabled then
        Exit;

    RestoreCtrlState;
    AlterCtrlState;
end; { FocusChanged }

{------------------------------------------------------------------------------}

{- Trigger OnBeforeFocus event then change the color property. -}
procedure TCtlFocus.AlterCtrlState;
var
    bChangeColor : Boolean;
    clFocusedColor : TColor;
begin
    clFocusedColor := FFocusedColor;    // Set default color.
    bChangeColor := True;                             // Default action is to change the color.

    DoBeforeFocus(bChangeColor, clFocusedColor);    // Opportunity to override default settings.

    if bChangeColor then
        SetColorProperty(FHostForm.ActiveControl, FLastColor, clFocusedColor);

    FLastFocusedCtrl := FHostForm.ActiveControl;
end; { AlterCtrlState }

{------------------------------------------------------------------------------}

{- Trigger the OnAfterFocus event then resore the color. -}
procedure TCtlFocus.RestoreCtrlState;
var
    bChangeColor : Boolean;
    sink : TColor;
begin
    if FLastFocusedCtrl <> nil then
    begin
        bChangeColor := True;         // The default action is to change the color.
        DoAfterFocus(bChangeColor, FLastColor, FLastFocusedCtrl);

        if bChangeColor then
            SetColorProperty(FLastFocusedCtrl, sink, FLastColor);
    end;
end; { RestoreCtrlState }

{------------------------------------------------------------------------------}

{- Trigger the OnAfterFocus event just before the control looses focus. -}
procedure TCtlFocus.DoAfterFocus(var AChangeColor: Boolean; var AFocusedColor: TColor; const AComponent: TComponent);
begin
    if Assigned(FOnAfterFocus) then
        FOnAfterFocus(Self, AComponent, AFocusedColor, AChangeColor);
end; { DoAfterFocus }

{------------------------------------------------------------------------------}

{- Trigger the OnBeforeFocus event just before the control receives focus. -}
procedure TCtlFocus.DoBeforeFocus(var AChangeColor: Boolean; var AFocusedColor : TColor);
begin
    if not Assigned(FHostForm.ActiveControl) then
        Exit;                                                                    // No active control.

    if Assigned(FOnBeforeFocus) then
        FOnBeforeFocus(Self, FHostForm.ActiveControl, AFocusedColor, AChangeColor);
end; { DoBeforeFocus }

{------------------------------------------------------------------------------}

{- Set the color property of AComponent using RTTI. -}
function TCtlFocus.SetColorProperty(AComponent: TComponent;
    var ACurrentColor: TColor; const AFocusedColor: TColor): Boolean;
var
    PropInfo : PPropInfo;
begin
    if not Assigned(AComponent) then
    begin
        Result := False;
        Exit;
    end;

    PropInfo := GetPropInfo(AComponent.ClassInfo, 'Color', [tkInteger]);
    if PropInfo = nil then
    begin
        Result := False;
        Exit;
    end;

    Result := True;

    ACurrentColor := TColor(GetOrdProp(AComponent, PropInfo));

    SetOrdProp(AComponent, PropInfo, LongInt(AFocusedColor));
end; { SetColorProperty }

{------------------------------------------------------------------------------}

function TCtlFocus.RunTime: Boolean;
begin
    RunTime := not (csDesigning in ComponentState);
end; { RunTime }


procedure Register;
begin
    RegisterComponents('DDJ', [TCtlFocus]);
end; { Register }

end.